uses Crt,Dos;
type
 AccessType=record
  Name:string;
  Tip:byte;
  Adr:word;
  Num:byte;
  Block:byte;
 end;
const
 Reg=1;
 Mem=2;
 Incr=3;
 Cmp=4;
 shift=$100;
 Types:array[1..4]of record
  Name:String[7];
  Size:byte;
  Arif:boolean;
     end=((Name:'INTEGER';Size:2;Arif:true),
          (Name:'WORD';Size:2;Arif:true),
          (Name:'BYTE';Size:1;Arif:true),
          (Name:'CHAR';Size:1;Arif:false));
 Digits: set of char=['0'..'9'];
 Liters: set of char=['A'..'Z'];
 Dividers: set of char=['+','-','*','/',':','.',';','=','[',']','(',')',
                        '<','>','"',','];
 SSize=48;
var

 InpStr:array[0..4096]of char;
 OutStr:array[0..4096]of byte;
 OutPtr:word;
 InpFileName,FName,FExt,Path:string;
 OutFileName:string;
 InpF,OutF:file;
 InpSize,InpPtr:word;
 Result:integer;
 CurWord:string;
 CurBlock:byte;
 VarTabl:record
   Field:array[1..1000]of record
          Name:String[16];
          Tip:byte;
          Size:word;
          Adr:word;
          Block:byte;
         end;
   FieldNum:word;
 end;
 ProcTabl:record
  Field:array[1..50]of record
          Name:string[16];
          Params:array[1..20]of record
                   Num:word ;
                   OutIt:boolean;
                 end;
          ParamNum:byte;
          Adr:Word;
         end;
  Num:word;
 end;
 Address:word;
 I:word;
 Stack:array[1..10000]of word;
 StackPtr:word;
 DataBase,DB:word;
 TmpInt:integer;
 StrNum:Word;
 ReadAdr:word;
procedure Prog;forward;
procedure Stmt;forward;
procedure Opers;forward;
procedure Xprs;forward;
procedure X2;forward;
procedure X3;forward;
procedure Vars;forward;
procedure Proc;forward;

procedure Error(Code:byte;Msg:string);
begin
 case code of
  1:Write('Повторное определение переменной ',Msg);
  2:Write('Ожидается символ ',Msg);
  3:Write('Ожидается слово ',Msg);
  4:Write('Неправильно указан ',Msg);
  5:Write('Ожидается ',Msg);
  6:Write('Неверный формат ',Msg);
  7:Write('Неверный тип операнда');
  8:Write('Неизвестный идентификатор ',Msg);
  9:Write('Ожидается переменная типа ',Msg);
 end;
  WriteLn(' ( cтрока ', StrNum,' )');
  WriteLn(CurWord);
 Halt(1);
end;
{============================WRITE1============================}
procedure Write1(Bt:byte);
begin
 OutStr[OutPtr]:=Bt;
 Inc(OutPtr);
end;
{============================WRITE2============================}
procedure Write2(Bt1,Bt2:byte);
begin
 OutStr[OutPtr]:=Bt1;
 OutStr[OutPtr+1]:=Bt2;
 Inc(OutPtr,2);
end;
{============================WRITE3============================}
procedure Write3(Bt1,Bt2,Bt3:byte);
begin
 OutStr[OutPtr]:=Bt1;
 OutStr[OutPtr+1]:=Bt2;
 OutStr[OutPtr+2]:=Bt3;
 Inc(OutPtr,3);
end;
{============================WRITE4============================}
procedure Write4(Bt1,Bt2,Bt3,Bt4:byte);
begin
 OutStr[OutPtr]:=Bt1;
 OutStr[OutPtr+1]:=Bt2;
 OutStr[OutPtr+2]:=Bt3;
 OutStr[OutPtr+3]:=Bt4;
 Inc(OutPtr,4);
end;
{===============================ToStack============================}
procedure ToStack(Param:word);
begin
 Stack[StackPtr]:=Param;
 Inc(StackPtr);
end;
{===============================FromStack==========================}
function FromStack:Word;
begin
 Dec(StackPtr);
 FromStack:=Stack[StackPtr];
end;
{===============================NEXT WORD==========================}
function NextWord:string;
var tmp:string;
begin
 Tmp:='';
 while (InpStr[InpPtr]in [#10,#13,' ','}','{']) do
  begin
   while InpStr[InpPtr] in [#10,#13,' ','}'] do
    begin
     if InpStr[InpPtr] =#10 then Inc(StrNum);
     inc (InpPtr);
    end;
   if InpStr[InpPtr]='{' then
     while InpStr[InpPtr]<>'}' do
    begin
     if InpStr[InpPtr] =#10 then Inc(StrNum);
     inc (InpPtr);
    end;
  end;
 if InpStr[InpPtr] in digits then
  while InpStr[InpPtr] in Digits do
   begin
    Tmp:=Tmp+InpStr[InpPtr];
    inc(InpPtr)
   end
 else
 if InpStr[InpPtr] in dividers then
  begin
    Tmp:=InpStr[InpPtr];
    inc(InpPtr);
  end
 else
 if UpCase(InpStr[InpPtr]) in Liters then
  while UpCase(InpStr[InpPtr]) in Digits+Liters do
   begin
    Tmp:=Tmp+UpCase(InpStr[InpPtr]);
    inc(InpPtr)
   end;
 NextWord:=Tmp;
end;
{================================InId=========================}
function InId(Name:string):word;
var I:word;
begin
  InId:=0;
  for I:=1 to VarTabl.FieldNum do
   if (VarTabl.Field[I].Name=Name)and((VarTabl.Field[I].Block=0)
      or(VarTabl.Field[I].Block=CurBlock)) then InId:=I;
end;
{==============================InProc==========================}
function InProc(Name:string):word;
var I:word;
begin
  InProc:=0;
  for I:=1 to ProcTabl.Num do
   if ProcTabl.Field[I].Name=Name then InProc:=I;
end;
{==============================OutInt==========================}
procedure OutInt;
var retpoint:word;
begin
 write1($50);
 write3($BF,$41,$01);
 write3($B9,$06,$00);
 write2($B0,$20);
 write2($F3,$AA);
 write1($58);
 write3($BF,$46,$01);
 write3($B9,$0A,$00);
 write2($B3,$20);
 write3($80,$FE,$00);
 write2($74,$09);
 write3($3D,$00,$00);
 write2($79,$04);
 write2($B3,$2D);
 write2($F7,$D8);
 write3($BA,$00,$00);
 write2($F7,$F1);
 write3($80,$CA,$30);
 write2($88,$15);
 write1($4F);
 write2($3C,$00);
 write2($75,$F1);
 write2($88,$1D);
 write3($BA,$41,$01);
 write2($B4,$09);
 write2($CD,$21);
 write1($C3);
 write3($2B,$2B,$2B);
 write4($2B,$2B,$2B,$24);
 write1($00);
end;
{----------------------ReadInt---------------------------------}
procedure ReadInt;
var BufAdr:word;
begin
 write2($EB,$0A);
 BufAdr:=OutPtr+shift;
 write3($07,$2E,$2E);   {bufer}
 write4($2E,$2E,$2E,$2E);
 write3($2E,$2E,$90);

 write3($BA,Lo(BufAdr),Hi(BufAdr));     {read string}
 write2($B0,$0A);
 write2($B4,$0C);
 write2($CD,$21);

 write3($B8,0,0);
 write3($B9,$0A,$00);
 write3($BB,$02,$00);
 write4($8A,$97,Lo(BufAdr),Hi(BufAdr));
 write3($80,$FA,$2D);
 write2($75,$01);
 write1($43);
 write4($80,$BF,Lo(BufAdr),Hi(BufAdr));write1($0D);
 write2($74,$10);
 write2($F7,$E1);
 write4($8A,$97,Lo(BufAdr),Hi(BufAdr));
 write3($80,$F2,$30);
 write2($B6,$00);
 write2($03,$C2);
 write1($43);
 write2($EB,$E9);
 write4($80,$3E,Lo(BufAdr+2),Hi(BufAdr+2));write1($2D);
 write2($75,$02);
 write2($F7,$D8);
 write1($50);
 write2($B4,$02);
 write2($B2,$0A);
 write2($CD,$21);
 write1($58);
 write1($C3);
end;
{----------------------MakeCompare-----------------------------}
procedure MakeCompare;
var    First,Second:char;
begin
   XPRS;
    Write1($50);                                     {Push AX}
    if CurWord[1] in ['<','>','='] then first:=CurWord[1];
    CurWord:=NextWord;
    if CurWord[1] in ['<','>','='] then
     begin
      Second:=CurWord[1];
      CurWord:=NextWord;
     end
    else Second:=' ';
    XPRS;
    Write1($5B);                                         {Pop BX}
    Write1($93);
    Write2($3B,$C3);                                     {cmp AX,BX}
    Case First of
     '=':Write2($74,$03);                                {je IF_lb}
     '>':Case Second of
          ' ':Write2($7F,$03);                           {jg}
          '=':Write2($7D,$03);                           {jge}
         end;
     '<':case Second of
          ' ':Write2($7C,$03);
          '=':Write2($7E,$03);
          '>':Write2($75,$03);
         end;
    end;
end;
{--------------------------------MakeAdr-----------------------}
procedure MakeAdr(var Access:AccessType);
begin
      Access.Name:=CurWord;
      Access.Num:=InId(Access.Name);
      if Access.Num=0 then Error(8,Access.Name);
      Access.Adr:=VarTabl.Field[Access.Num].Adr;
      Access.Tip:=VarTabl.Field[Access.Num].Tip;
      Access.Block:=VarTabl.Field[Access.Num].Block;
      CurWord:=NextWord;
      if CurWord='[' then
       begin
         CurWord:=NextWord;
         XPRS;
         Write3($2D,$01,$00);                         {SUB AX,1}
         if Types[Access.Tip].Size=2 then Write2($D1,$E0);  {SHL AX,1}
         if CurWord<>']' then Error(2,']');
         CurWord:=NextWord;
       end
      else  Write2($2B,$C0);                          {SUB AX,AX}
end;
{--------------------------------MoveWord----------------------}
procedure MoveWord(Access:AccessType;Dest:byte);
begin
 if Access.Block=0 then
 begin
  Case Dest of
  Reg:if Types[Access.Tip].Size = 1 then Write4($B4,$00,$8A,$87)
      else write2($8B,$87);
  Mem:if Types[Access.Tip].Size = 1 then Write2($88,$87)
      else write2($89,$87);
  Incr:if Types[Access.Tip].Size = 1 then Write2($FE,$87)
       else write2($FF,$87);
  Cmp:if Types[Access.Tip].Size = 1 then Write2($3A,$87)
      else write2($3B,$87);
  end;
  write2(Lo(DataBase+Access.Adr),Hi(DataBase+Access.Adr));
 end
 else
 begin
  write2($8B,$F3);
  Case Dest of
  Reg:if Types[Access.Tip].Size = 1 then Write4($B4,$00,$8A,$82)
      else write2($8B,$82);
  Mem:if Types[Access.Tip].Size = 1 then Write2($88,$82)
      else write2($89,$82);
  Incr:if Types[Access.Tip].Size = 1 then Write2($FE,$82)
       else write2($FF,$82);
  Cmp:if Types[Access.Tip].Size = 1 then Write2($3A,$82)
      else write2($3B,$82);
  end;
  write2(Lo(-DB+Access.Adr+2),Hi(-DB+Access.Adr+2));
 end

end;
{================================Prog==========================}
procedure Prog;
var retpoint:word;
 begin
  CurBLock:=0;
  CurWord:=NextWord;
  While CurWord='DEFINE' do Vars;
  DataBase:=$FFFE-Address;
  Write3($BC,Lo(DataBase),Hi(DataBase));   {mov SP,0FFFEh-Address}
  write3($E9,$00,$00);
  retpoint:=OutPtr;
  OutInt;
  ReadAdr:=OutPtr;
  ReadInt;
  while CurWord='PROCEDURE' do Proc;
  CurBlock:=0;
  OutStr[retpoint-2]:=Lo(OutPtr-RetPoint);
  OutStr[retpoint-1]:=Hi(OutPtr-RetPoint);
  if CurWord<>'BEGIN' then Error(3,' begin');
  Stmt;
  if NextWord<>'.' then Error(3,'.');

  Write1($90);
  Write3($B8,$00,$4C);
  Write2($CD,$21);
 end;
{===========================VARS==============================}
procedure Vars;
var I:integer;
    NewName:string;
    NewNum:byte;
    Code,NewSize:integer;
 begin
  CurWord:=NextWord;
  if (InId(CurWord)<>0)and(VarTabl.Field[InId(CurWord)].Block=CurBlock)
  then Error(1,CurWord)
  else
   begin
    NewName:=CurWord;
    if NextWord<>':' then Error(2,':');
    CurWord:=NextWord;
    NewNum:=0;
    for i:=1 to 4 do
     if CurWord=Types[i].Name then NewNum:=i;
    if NewNum=0 then Error(4,'тип');
    CurWord:=NextWord;
    if CurWord<>';' then
     if CurWord<>'[' then Error(2,'[')
     else
      begin
       Curword:=NextWord;
       Val(CurWord,NewSize,Code);
       if (Code<>0) or (NewSize<1) then Error(5,'натуральное число');
       If NextWord<>']' then Error(2,']');
       If NextWord<>';' then Error(2,';');
      end
     else NewSize:=1;
     with VarTabl do
      begin
       Inc(FieldNum);
       Field[FieldNum].Name:=NewName;
       Field[FieldNum].Tip:=NewNum;
       Field[FieldNum].Size:=NewSize;
       Field[FieldNum].Adr:=Address;
       Field[FieldNum].Block:=CurBlock;
       Inc(Address,Field[FieldNum].Size*Types[Field[FieldNum].Tip].Size);
      end;
   end ;
   CurWord:=NextWord;
 end;
{===========================Proc==============================}
procedure Proc;
var
 FrmSize:word;
 I:byte;
 Access:AccessType;
begin
 Inc(CurBlock);
 Inc(ProcTabl.Num);
 FrmSize:=0;
 Address:=0;
 CurWord:=NextWord;
 if InProc(CurWord)<>0 then Error(1,CurWord);
 ProcTabl.field[ProcTabl.Num].Name:=CurWord;
 CurWord:=NextWord;
 with ProcTabl.Field[ProcTabl.Num] do
 begin
 Adr:=OutPtr;
  while not (CurWord='BEGIN') do
   begin
    if (CurWord='VAR')or (CurWord='PARAM') then
     begin
      Inc(ParamNum);
      if CurWord='VAR' then Params[ParamNum].OutIt:=true
      else  Params[ParamNum].OutIt:=false;
      Vars;
      Params[ParamNum].Num:=VarTabl.FieldNum;
     end
    else
    if CurWord='DEFINE' then
     begin
      Vars;
     end
    else error(3,'begin');
    Inc(FrmSize,Types[VarTabl.Field[VarTabl.FieldNum].Tip].Size*
    VarTabl.Field[VarTabl.FieldNum].Size);
   end;
   write4($C8,Lo(FrmSize),Hi(FrmSize),$1);{ENTER}
   DB:=FrmSize;
   for I:=1 to ParamNum do
    begin
     Write3($8B,$46,(ParamNum-I+2)*2);
     Access.Num:=Params[I].Num;
     Access.Name:=VarTabl.Field[Access.Num].Name;
     Access.Adr:=VarTabl.Field[Access.Num].Adr;
     Access.Tip:=VarTabl.Field[Access.Num].Tip;
     Access.Block:=VarTabl.Field[Access.Num].Block;
     Write2($2B,$DB);
     MoveWord(Access,mem);
    end;
   Stmt;
   CurWord:=NextWord;
   Write2($C9,$C3);                       {LEAVE}
  end;
end;
{===========================STMT==============================}
procedure Stmt;
 begin
  CurWord:=NextWord;
  While CurWord<>'END' do
   OPERS
 end;
{===============================Opers========================}
procedure Opers;
var Access:AccessType;
    Tmp,NewNum:word;
    VarPos:word;
    StrBeg:word;
    IfPtr,ElsePtr,WhilePtr1,WhilePtr2:word;
    ToEnd,ToBegin:word;
    I:word;

 begin

  if CurWord='CALL' then
   begin
    CurWord:=NextWord;
    NewNum:=InProc(CurWord);
    if InProc(CurWord)=0 then error(8,CurWord);
    CurWord:=NextWord;
    if (CurWord<>'(')and(ProcTabl.Field[NewNum].ParamNum>0)then error(2,'(');
    for I:=1 to  ProcTabl.Field[NewNum].ParamNum do
     begin
      CurWord:=NextWord;
      XPRS;
      Write1($50);
     end;
    Write3($E8,Lo($FFFF-(OutPtr-ProcTabl.Field[NewNum].Adr)-2),
               Hi($FFFF-(OutPtr-ProcTabl.Field[NewNum].Adr)-2));
    for I:=1 to  ProcTabl.Field[NewNum].ParamNum do
      Write1($58);

    if (CurWord<>')')and(ProcTabl.Field[NewNum].ParamNum>0)then error(2,')');
    CurWord:=NextWord;
   end
  else
  if CurWord='PRINTI' then {вывод числа со знаком}
   begin
    CurWord:=NextWord;
    XPRS;
    Write2($B6,$01);
    Write3($E8,Lo($FFFF-(OutPtr+3)+7),Hi($FFFF-(OutPtr+3)+7));
   end
  else
  if CurWord='PRINTW' then {вывод числа без знака}
   begin
    CurWord:=NextWord;
    XPRS;
    Write2($B6,$00);
    Write3($E8,Lo($FFFF-(OutPtr+3)+7),Hi($FFFF-(OutPtr+3)+7));
   end
  else
  if CurWord='PRINTS' then {вывод строки - константы}
   begin
     If NextWord<>'(' then error(2,'(');
     If NextWord<>'"' then error(2,'"');
     Inc(OutPtr,2);
     StrBeg:=OutPtr;
     while InpStr[InpPtr]<>'"' do
      begin
       Write1(Ord(InpStr[InpPtr]));
       Inc(InpPtr)
      end;
     inc(InpPtr);
     CurWord:=NextWord;
     if CurWord='L'then
      begin
       CurWord:=NextWord;
       Write2(13,10);
      end;
     Write1(Ord('$'));
     if CurWord<>')' then error(2,')');
     OutStr[StrBeg-2]:=$EB;{jmp short}
     OutStr[StrBeg-1]:=OutPtr-StrBeg;
     Write3($BA,Lo(StrBeg+shift),Hi(StrBeg+shift));
     Write3($B8,$00,$09);
     Write2($CD,$21);
     CurWord:=NextWord;
   end
  else
  if CurWord='BEGIN' then              {begin}
   begin
    CurWord:=NextWord;
    while CurWord<>'END' do
     begin
      Opers;
     end;
    CurWord:=NextWord;
   end
  else
  if CurWord='IF'then              {IF}
   begin
    CurWord:=NextWord;
    MakeCompare;
    Write3($E9,0,0);
    IfPtr:=OutPtr;
    If CurWord <> 'THEN' then Error(3,'then');
    CurWord:=NextWord;
    Opers;
    if CurWord='ELSE' then
     begin
      Write3($E9,0,0);
      ElsePtr:=OutPtr;
     end
    else ElsePtr:=0;
    OutStr[IfPtr-2]:=Lo(OutPtr-IfPtr);
    OutStr[IfPtr-1]:=Hi(OutPtr-IfPtr);
    if ElsePtr<>0 then
     begin
      CurWord:=NextWord;
      Opers;
      OutStr[ElsePtr-2]:=Lo(OutPtr-ElsePtr);
      OutStr[ElsePtr-1]:=Hi(OutPtr-ElsePtr);
     end;
   end
  else
  if CurWord='WHILE'then              {WHILE}
   begin
    CurWord:=NextWord;
    WhilePtr1:=OutPtr;
    MakeCompare;
    Write3($E9,0,0);
    WhilePtr2:=OutPtr;
    If CurWord <> 'DO' then Error(3,'do');
    CurWord:=NextWord;
    Opers;
    TmpInt:=OutPtr-WhilePtr1+3;
    TmpInt:=-TmpInt;
    Write3($E9,Lo(TmpInt),Hi(TmpInt));
    OutStr[WhilePtr2-2]:=Lo(OutPtr-WhilePtr2);
    OutStr[WhilePtr2-1]:=Hi(OutPtr-WhilePtr2);
   end
  else
  if CurWord='FOR' then                           {For}
   begin
     CurWord:=NextWord;
     MakeAdr(Access);
     if CurWord<>'=' then Error(2,'=');
     CurWord:=NextWord;
     Write1($50);                                     {Push AX}
     XPRS;
     Write2($5B,$53);                                     {Pop BX}
     MoveWord(Access,Mem);
     if CurWord<>'TO' then Error(3,'to');
     ToBegin:=OutPtr;
     CurWord:=NextWord;
     XPRS;
     write2($5B,$53);           {pop BX}
     MoveWord(Access,Cmp);
     Write2($7D,$03);
     Write3($E9,0,0);
     ToEnd:=OutPtr;
     if CurWord<>'DO' then Error(3,'do');
     CurWord:=NextWord;
     Opers;
     write2($5B,$53);           {pop BX}
     MoveWord(Access,Incr);
     TmpInt:=OutPtr-ToBegin+3;
     TmpInt:=-TmpInt;
     Write3($E9,Lo(TmpInt),Hi(TmpInt));
     OutStr[ToEnd-2]:=Lo(OutPtr-ToEnd);
     OutStr[ToEnd-1]:=Hi(OutPtr-ToEnd);
     write1($5B);
   end
  else
  if InId(CurWord)<>0 then    {:=}
   begin
    MakeAdr(Access);
    if CurWord<>'=' then Error(2,'=');
    CurWord:=NextWord;
    Write1($50);                                     {Push AX}
    XPRS;
    Write1($5B);                                     {Pop BX}
    MoveWord(Access,Mem);
   end
   else
    Error(7,CurWord);
 end;
{============================XPRS=============================}
Procedure XPRS;
 begin
  X2;
  While CurWord[1] in ['+','-'] do
   begin
    Write1($50);                                      {Push AX}
    if not (CurWord[1] in ['+','-']) then Error(2,'"+" или "-"');
    ToStack(Ord(CurWord[1]));
    CurWord:=NextWord;
    X2;
    Write1($5B);                                      {Pop BX}
    case Chr(Lo(FromStack)) of
      '+':Write2($03,$C3);                            {Add AX,BX}
      '-':Write3($93,$2B,$C3);                        {XCRG AX,BX ; Sub AX,BX}
    end;
   end;
 end;
{========================== X2 ===============================}
Procedure X2;
 begin
  X3;
  While CurWord[1] in ['*','/'] do
   begin
    Write1($50);                                      {Push AX}
    if not (CurWord[1] in ['*','/']) then Error(2,'"*" или "/"');
    ToStack(Ord(CurWord[1]));
    CurWord:=NextWord;
    X3;
    Write1($5B);                                      {Pop BX}
    case Chr(Lo(FromStack)) of
      '*':Write2($F7,$E3);                            {Mul AX,BX}
      '/':Write3($93,$F6,$F3);                        {XCRG AX,BX ; Div AX,BX}
    end;
    end;
 end;
{============================ X3===========================}
Procedure X3;
var
    Code,I,TmpInt:integer;
    Tmp:word;
    Access:AccessType;
  begin
  if CurWord='CON' then
   begin
    TmpInt:=OutPtr-ReadAdr+3;
    TmpInt:=-TmpInt;
    Write3($E8,Lo(TmpInt),Hi(TmpInt));
    CurWord:=NextWord
   end
  else
  if CurWord[1]='"' then
   begin
       CurWord:=NextWord;
       Write4($2A,$E4,$B0,Ord(InpStr[InpPtr-1]));
       if NextWord<>'"' then Error(2,'"');
       CurWord:=NextWord;
   end
  else
  if CurWord[1] in ['0'..'9'] then
   begin
    Val(CurWord,I,code);
    if Code<>0 then Error(6,'числа');
    Write3($B8,Lo(I),Hi(I));  {mov AX,CurWord}
    CurWord:=NextWord;
   end
  else
   if CurWord='(' then
    begin
     CurWord:=NextWord;
     XPRS;
     if CurWord<>')' then Error(2,')');
     CurWord:=NextWord;
    end
   else
    if InId(CurWord)<>0 then
     begin
      MakeAdr(Access);
      Write2($8B,$D8);                             {mov BX,AX}
      MoveWord(Access,Reg);
     end
    Else Error(8,CurWord);
 end;
{||||||||||||||||||||||||MAIN|||||||||||||||||||||||||||||||||}
begin
 ProcTabl.Num:=0;
 StrNum:=1;
 if ParamCount<1 then
  begin
   WriteLn('Формат вызова COMPILER [Имя файла].prg');
   Halt(1);
  end;
 InpFileName:=ParamStr(1);
 VarTabl.FieldNum:=0;
 Address:=0;
 InpPtr:=0;
 OutPtr:=0;
 StackPtr:=0;
 Assign(InpF,InpFileName);
 Reset(InpF,1);
 BlockRead(InpF,InpStr,SizeOf(InpStr),InpSize);
 Close(InpF);
 Prog;
 I:=1;
 OutFileName:='';
 while (inpfilename[I]<>'.')and(I<Length(InpFileName))do
  begin
   OutFileName:=OutFileName+InpFileName[I];
   Inc(I);
  end;
 Assign(OutF,OutFileName+'.com');
 writeln('Компиляция успешно завершена');
 Rewrite(OutF,1);
 BlockWrite(OutF,OutStr,OutPtr);
 Close(OutF);
end.